Timeline Visualization
library(scales)
library(lubridate)
##
## Attaching package: 'lubridate'
## The following objects are masked from 'package:base':
##
## date, intersect, setdiff, union
library(ggplot2)
library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ stringr 1.5.1
## ✔ forcats 1.0.0 ✔ tibble 3.2.1
## ✔ purrr 1.0.2 ✔ tidyr 1.3.0
## ✔ readr 2.1.5
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ readr::col_factor() masks scales::col_factor()
## ✖ purrr::discard() masks scales::discard()
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(knitr)
## Warning: package 'knitr' was built under R version 4.3.3
library(timevis)
Merkel <- data.frame(
Year = c(rep(c(2018), times =12), rep(c(2019), times =2)),
Months = c(1,2,2,3,6,9,9,10,11,11,12,12,1,3),
Days = c(1,2,15,2,2,8,29,20,10,27,1,23,15,10),
Milestones = c("Diagnosed with MCC", "PET-CT (No evidence of metastatic disease)", "WLE and SLNBx", "PET-CT (No evidence of disease)", "PET-CT (No evidence of disease)", "PET-CT (Concerning for Recurrence)", "Cycle 1", "Cycle 2", "Cycle 3","PET-CT (Partial Response)","Cycle 4", "Cycle 5", "Cycle 6","PET-CT (Complete Response)"),
Event_type= c("Biopsy", "Imaging", "Surgery", "Imaging", "Imaging", "Imaging", "Immunotherapy", "Immunotherapy","Immunotherapy","Imaging","Immunotherapy", "Immunotherapy", "Immunotherapy", "Imaging")) #The data set was created with the year, month and day in separate columns. Let's add the complete date column now
Merkel$date <- with(Merkel, ymd(sprintf('%04d%02d%02d', Merkel$Year, Merkel$Months, Merkel$Days)))
# of note, the ymd() function transforms dates stored in character and numeric vectors to Date
## we are using the code with(df, ymd(sprintf('%04d%02d%02d', year, mon, day))) to take those three columns and merge them into one that is recognized as a date in R
Merkel <- Merkel[with(Merkel, order(date)), ]
# of note, an alternate code to arrange the df in ascending date order would have been:
## Merkel <- Merkel %>% arrange(date)
kable(head(Merkel))
| 2018 |
1 |
1 |
Diagnosed with MCC |
Biopsy |
2018-01-01 |
| 2018 |
2 |
2 |
PET-CT (No evidence of metastatic disease) |
Imaging |
2018-02-02 |
| 2018 |
2 |
15 |
WLE and SLNBx |
Surgery |
2018-02-15 |
| 2018 |
3 |
2 |
PET-CT (No evidence of disease) |
Imaging |
2018-03-02 |
| 2018 |
6 |
2 |
PET-CT (No evidence of disease) |
Imaging |
2018-06-02 |
| 2018 |
9 |
8 |
PET-CT (Concerning for Recurrence) |
Imaging |
2018-09-08 |
# Add a specified order to these event type labeles
Event_type_levels <- c("Biopsy", "Surgery", "Imaging", "Immunotherapy")
# Define the colors for the event types in the specified order.
## These hashtagged codes represent the colors (blue, green, yellow, red) as hexadecimal color codes.
Event_type_colors <- c("#C00000", "#FFC000", "#00B050", "#0070C0" )
# Make the Event_type vector a factor using the levels we defined above
Merkel$Event_type <- factor(Merkel$Event_type, levels= Event_type_levels, ordered=TRUE)
# Set the heights we will use for our milestones.
positions <- c(0.5, -0.5, 1.0, -1.0, 1.25, -1.25, 1.5, -1.5)
# Set the directions we will use for our milestone, for example above and below.
directions <- c(1, -1)
# Assign the positions & directions to each date from those set above.
line_pos <- data.frame(
"date"=unique(Merkel$date),
"position"=rep(positions, length.out=length(unique(Merkel$date))),
"direction"=rep(directions, length.out=length(unique(Merkel$date))))
# Create columns with the specified positions and directions for each milestone event
Merkel <- merge(x=Merkel, y=line_pos, by="date", all = TRUE)
# Let's view the new columns.
kable(head(Merkel))
| 2018-01-01 |
2018 |
1 |
1 |
Diagnosed with MCC |
Biopsy |
0.50 |
1 |
| 2018-02-02 |
2018 |
2 |
2 |
PET-CT (No evidence of metastatic disease) |
Imaging |
-0.50 |
-1 |
| 2018-02-15 |
2018 |
2 |
15 |
WLE and SLNBx |
Surgery |
1.00 |
1 |
| 2018-03-02 |
2018 |
3 |
2 |
PET-CT (No evidence of disease) |
Imaging |
-1.00 |
-1 |
| 2018-06-02 |
2018 |
6 |
2 |
PET-CT (No evidence of disease) |
Imaging |
1.25 |
1 |
| 2018-09-08 |
2018 |
9 |
8 |
PET-CT (Concerning for Recurrence) |
Imaging |
-1.25 |
-1 |
# Create a one month "buffer" at the start and end of the timeline
month_buffer <- 1
month_date_range <- seq(min(Merkel$date) - months(month_buffer), max(Merkel$date) + months(month_buffer), by='month')
# We are adding one month before and one month after the earliest and latest milestone in the clinical course.
## We want the format of the months to be in the 3 letter abbreviations of each month.
month_format <- format(month_date_range, '%b')
month_df <- data.frame(month_date_range, month_format)
year_date_range <- seq(min(Merkel$date) - months(month_buffer), max(Merkel$date) + months(month_buffer), by='year')
# We will only show the years for which we have a december to january transition.
year_date_range <- as.Date(
intersect(
ceiling_date(year_date_range, unit="year"),
floor_date(year_date_range, unit="year")),
origin = "1970-01-01")
# We want the format to be in the four digit format for years.
year_format <- format(year_date_range, '%Y')
year_df <- data.frame(year_date_range, year_format)
# Create timeline coordinates with an x and y axis
timeline_plot<-ggplot(Merkel,aes(x=date,y= position, col=Event_type, label=Merkel$Milestones))
# Add the label Milestones
timeline_plot<-timeline_plot+labs(col="Milestones")
# Print plot
timeline_plot
## Warning: Use of `Merkel$Milestones` is discouraged.
## ℹ Use `Milestones` instead.

# Assigning the colors and order to the milestones
timeline_plot<-timeline_plot+scale_color_manual(values=Event_type_colors, labels=Event_type_levels, drop = FALSE)
# Using the classic theme to remove background gray
timeline_plot<-timeline_plot+theme_classic()
# Plot a horizontal line at y=0 for the timeline
timeline_plot<-timeline_plot+geom_hline(yintercept=0,
color = "black", size=0.3)
## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
# Print plot
timeline_plot

# Plot the vertical lines for our timeline's milestone events
timeline_plot<-timeline_plot+geom_segment(data=Merkel, aes(y=Merkel$position,yend=0,xend=Merkel$date), color='black', size=0.2)
# Now let's plot the scatter points at the tips of the vertical lines and date
timeline_plot<-timeline_plot+geom_point(aes(y=Merkel$position), size=3)
# Let's remove the axis since this is a horizontal timeline and postion the legend to the bottom
timeline_plot<-timeline_plot+theme(axis.line.y=element_blank(),
axis.text.y=element_blank(),
axis.title.x=element_blank(),
axis.title.y=element_blank(),
axis.ticks.y=element_blank(),
axis.text.x =element_blank(),
axis.ticks.x =element_blank(),
axis.line.x =element_blank(),
legend.position = "bottom"
)
# Print plot
timeline_plot
## Warning: Use of `Merkel$position` is discouraged.
## ℹ Use `position` instead.
## Warning: Use of `Merkel$date` is discouraged.
## ℹ Use `date` instead.
## Warning: Use of `Merkel$Milestones` is discouraged.
## ℹ Use `Milestones` instead.
## Warning: Use of `Merkel$position` is discouraged.
## ℹ Use `position` instead.
## Warning: Use of `Merkel$Milestones` is discouraged.
## ℹ Use `Milestones` instead.

# Let's add the text for each month
timeline_plot<-timeline_plot+geom_text(data=month_df, aes(x=month_date_range,y=-0.15,label=month_format),size=3.5,vjust=0.5, color='black', angle=90)
# Let's add the years
timeline_plot<-timeline_plot+geom_text(data=year_df, aes(x=year_date_range,y=-0.25,label=year_format, fontface="bold"),size=3.5, color='black')
# Print plot
print(timeline_plot)
## Warning: Use of `Merkel$position` is discouraged.
## ℹ Use `position` instead.
## Warning: Use of `Merkel$date` is discouraged.
## ℹ Use `date` instead.
## Warning: Use of `Merkel$Milestones` is discouraged.
## ℹ Use `Milestones` instead.
## Warning: Use of `Merkel$position` is discouraged.
## ℹ Use `position` instead.
## Warning: Use of `Merkel$Milestones` is discouraged.
## ℹ Use `Milestones` instead.

# We need to add the labels of each milestone now.
## To do this we have to define the text position. A clean timeline should have the labels situatuated a bit above the scatter points.
### Since we have the positions of the points already defined, we will place the labels 0.2 pts away from the scatter points.
# Lets offset the labels 0.2 away from scatter points
text_offset <- 0.2
# Let's use the absolute value since we want to add the text_offset and increase space away from the scatter points
absolute_value<-(abs(Merkel$position))
text_position<- absolute_value + text_offset
# Let's keep the direction above or below for the labels to match the scatter points
Merkel$text_position<- text_position * Merkel$direction
# View head of the table
kable(head(Merkel))
| 2018-01-01 |
2018 |
1 |
1 |
Diagnosed with MCC |
Biopsy |
0.50 |
1 |
0.70 |
| 2018-02-02 |
2018 |
2 |
2 |
PET-CT (No evidence of metastatic disease) |
Imaging |
-0.50 |
-1 |
-0.70 |
| 2018-02-15 |
2018 |
2 |
15 |
WLE and SLNBx |
Surgery |
1.00 |
1 |
1.20 |
| 2018-03-02 |
2018 |
3 |
2 |
PET-CT (No evidence of disease) |
Imaging |
-1.00 |
-1 |
-1.20 |
| 2018-06-02 |
2018 |
6 |
2 |
PET-CT (No evidence of disease) |
Imaging |
1.25 |
1 |
1.45 |
| 2018-09-08 |
2018 |
9 |
8 |
PET-CT (Concerning for Recurrence) |
Imaging |
-1.25 |
-1 |
-1.45 |
# Now we can add the labels to the timeline for our milestones.
timeline_plot<-timeline_plot+geom_text(aes(y=Merkel$text_position,label=Merkel$Milestones),size=3.5, vjust=0.6)
# Print plot
print(timeline_plot)

# Now we can add the labels to the timeline for our milestones.
timeline_plot<-timeline_plot+geom_text(aes(y=Merkel$text_position,label=Merkel$Milestones),size=3.5, vjust=0.6)
# Print plot
print(timeline_plot)

library(plotly)
##
## Attaching package: 'plotly'
## The following object is masked from 'package:ggplot2':
##
## last_plot
## The following object is masked from 'package:stats':
##
## filter
## The following object is masked from 'package:graphics':
##
## layout
ggplotly(timeline_plot)
# Let's prepare our data so that it is compatible with quick visualization in timevis
## Each milestone will need a start date added. If it is a duration, we will also supply the end date
# Let's remove Cycles 2,3,4,5 and 6 since we will just show the patient's duration on systemic therapy and not the individual cycle dates
MCC<- Merkel[-c(8,9,11:13),]
# The start date for each milestone is the date of the event.
## If it was a single date event and not a duration, it will not have an end date.
MCC$start <-MCC$date
# The end date will be "NA" if the event had no duration.
## Only systemic therapy will have an end date which will be the date of cycle 6.
MCC$end<-c(NA, NA, NA, NA, NA, NA,"2019-01-15", NA, NA)
#Let's replace the label "Cycle 1" with "Checkpoint Inhibitor- Systemic Therapy" using library stringr
library(stringr)
MCC$Milestones<-str_replace_all(MCC$Milestones, "Cycle 1", "Checkpoint Inhibitor- Systemic Therapy")
# Each milestone will need an ID for visualization and content for labels.
MCC$id<- 1:9
MCC$content<- MCC$Milestones
kable(head(MCC))
| 2018-01-01 |
2018 |
1 |
1 |
Diagnosed with MCC |
Biopsy |
0.50 |
1 |
0.70 |
2018-01-01 |
NA |
1 |
Diagnosed with MCC |
| 2018-02-02 |
2018 |
2 |
2 |
PET-CT (No evidence of metastatic disease) |
Imaging |
-0.50 |
-1 |
-0.70 |
2018-02-02 |
NA |
2 |
PET-CT (No evidence of metastatic disease) |
| 2018-02-15 |
2018 |
2 |
15 |
WLE and SLNBx |
Surgery |
1.00 |
1 |
1.20 |
2018-02-15 |
NA |
3 |
WLE and SLNBx |
| 2018-03-02 |
2018 |
3 |
2 |
PET-CT (No evidence of disease) |
Imaging |
-1.00 |
-1 |
-1.20 |
2018-03-02 |
NA |
4 |
PET-CT (No evidence of disease) |
| 2018-06-02 |
2018 |
6 |
2 |
PET-CT (No evidence of disease) |
Imaging |
1.25 |
1 |
1.45 |
2018-06-02 |
NA |
5 |
PET-CT (No evidence of disease) |
| 2018-09-08 |
2018 |
9 |
8 |
PET-CT (Concerning for Recurrence) |
Imaging |
-1.25 |
-1 |
-1.45 |
2018-09-08 |
NA |
6 |
PET-CT (Concerning for Recurrence) |
timevis(MCC)